home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / LOCALM~1 / ExeType.bas < prev    next >
BASIC Source File  |  1997-06-14  |  5KB  |  180 lines
  1. Attribute VB_Name = "MExeType"
  2. Option Explicit
  3.  
  4. Public Enum EErrorExeType
  5.     eeBaseExeType = 13470   ' ExeType
  6. End Enum
  7.  
  8. ' Valid Exe types (for ExeType function)
  9.  
  10. Public Enum EProgramType
  11.     ' Unknown - could still be .BAT, .CMD, .COM, or .PIF
  12.     eptNotExe = 0
  13.     ' Recognized executable types
  14.     eptMSDOS = 1
  15.     eptWin16 = 2
  16.     eptOS2_1 = 3
  17.     eptWin32 = 4
  18.     eptWin32Console = 5
  19.     eptDOSUnknown = 7
  20.     ' Errors
  21.     eptNoFile = -1
  22.     eptOS2_2 = -2
  23.     eptWinOS2DLL = -3
  24.     eptNEUnknown = -4
  25.     eptNTNonIntel = -5
  26.     eptWin32DLL = -6
  27.     eptAccessFail = -7
  28. End Enum
  29.  
  30. ' Check to see if specified file is executable, and if so, what kind
  31. Function ExeType(sSpec As String) As EProgramType
  32.     On Error GoTo ExeTypeFail
  33.     Dim hFile As Integer
  34.     hFile = FreeFile
  35.     If MUtility.ExistFile(sSpec) Then
  36.         Open sSpec For Binary Access Read Shared As hFile
  37.     Else
  38.         ExeType = eptNoFile
  39.         Exit Function
  40.     End If
  41.  
  42.     Dim abHeader() As Byte
  43.     ReDim abHeader(128)
  44.     Get hFile, 1, abHeader
  45.  
  46.     ' MS-DOS headers start with magic header "MZ"
  47.     Dim sMagic As String, bData As Byte, wData As Integer
  48.     sMagic = MBytes.LeftBytes(abHeader, 2)
  49.     If sMagic <> "MZ" Then
  50.         ' Could still be a .BAT, .CMD, .PIF, or .COM file
  51.         ExeType = eptNotExe
  52.         Close hFile
  53.         Exit Function
  54.     End If
  55.  
  56.     ' If word at offset &H18 does not point beyond DOS header
  57.     ' (length &H40), file is MS-DOS EXE
  58.     If MBytes.BytesToWord(abHeader, &H18) < &H40 Then
  59.         ExeType = eptMSDOS
  60.         Close hFile
  61.         Exit Function
  62.     End If
  63.  
  64.     ' Get offset of new EXE header
  65.     wData = MBytes.BytesToWord(abHeader, &H3C)
  66.     Get hFile, wData + 1, abHeader
  67.     Close hFile
  68.  
  69.     ' New .EXE headers start with magic header "NE"
  70.     sMagic = MBytes.LeftBytes(abHeader, 2)
  71.     ' Check for Windows/OS2 format
  72.     If sMagic = "NE" Then
  73.  
  74.         ' Get the executable file flags to check for DLL
  75.         If abHeader(&HD) And &H80 Then
  76.             ' This is a DLL (executable but not by us)
  77.             ExeType = eptWinOS2DLL
  78.         Else
  79.             ' Get the operating system flags (byte, not word)
  80.             bData = abHeader(&H36)
  81.             If bData And &H2 Then
  82.                 ExeType = eptWin16 ' Windows
  83.             ElseIf bData And &H1 Then
  84.                 ExeType = eptOS2_1 ' OS/2 1.x
  85.             Else
  86.                 ' Unknown NE system, probably bound, but call it MS-DOS
  87.                 ExeType = eptMSDOS
  88.             End If
  89.         End If
  90.  
  91.     ' Check for OS/2 2.x format (can't execute from Windows or NT)
  92.     ElseIf sMagic = "LE" Then
  93.         ExeType = eptOS2_2 ' OS/2 LE
  94.     ' Check for NT format
  95.     ElseIf sMagic = "PE" And MBytes.BytesToWord(abHeader, &H2) = 0 Then
  96.         ' Get processor flags
  97.         bData = abHeader(&H4)
  98.         Select Case bData
  99.         Case &H4C, &H4D, &H4E, &H4F ' NT for intel 386, 486, 586, 686
  100.             ExeType = eptWin32 ' NT Windows
  101.         Case Else
  102.             ExeType = eptNTNonIntel ' Some sort of RISC or other
  103.             Exit Function
  104.         End Select
  105.  
  106.         ' Get the Exe type flags
  107.         If abHeader(&H17) And &H20 Then
  108.             ExeType = eptWin32DLL ' Executable, but not by us
  109.             Exit Function
  110.         End If
  111.  
  112.         ' Get the subsystem flags to identify NT character
  113.         If abHeader(&H5C) = 3 Then ExeType = eptWin32Console
  114.         ' Could also identify Posix here
  115.  
  116.     Else
  117.         ' MS-DOS file with a header, but notNE file
  118.         ' (Some 16-bit DOS-extended executables fall through here, or
  119.         ' could be non-EXE file with "MZ" as first two bytes)
  120.         ExeType = eptDOSUnknown ' Probably DOS extended
  121.     End If
  122.     Exit Function
  123.     
  124. ExeTypeFail:
  125.     ExeType = eptAccessFail
  126. End Function
  127.  
  128. Function ExeTypeStr(sFile As String) As String
  129.     Select Case ExeType(sFile)
  130.     ' Valid Exe types (for ExeType function)
  131.     Case eptMSDOS
  132.         ExeTypeStr = "MS-DOS"
  133.     Case eptWin16
  134.         ExeTypeStr = "Windows 16-bit"
  135.     Case eptOS2_1
  136.         ExeTypeStr = "OS/2 1.x"
  137.     Case eptWin32
  138.         ExeTypeStr = "Windows 32-bit"
  139.     Case eptWin32Console
  140.         ExeTypeStr = "Windows 32-bit Console"
  141.     Case eptDOSUnknown
  142.         ExeTypeStr = "Unknown MS-DOS Compatible"
  143.     Case eptNotExe
  144.         ExeTypeStr = "Not EXE File"
  145.     Case eptNoFile
  146.         ExeTypeStr = "No File"
  147.     Case eptOS2_2
  148.         ExeTypeStr = "OS/2 2.x"
  149.     Case eptWinOS2DLL
  150.         ExeTypeStr = "Windows 3.x or OS/2 DLL"
  151.     Case eptNEUnknown
  152.         ExeTypeStr = "Unknown Format"
  153.     Case eptNTNonIntel
  154.         ExeTypeStr = "Non-Intel Windows"
  155.     Case eptWin32DLL
  156.         ExeTypeStr = "Windows 32-bit DLL"
  157.     End Select
  158. End Function
  159.  
  160. #If fComponent = 0 Then
  161. Private Sub ErrRaise(e As Long)
  162.     Dim sText As String, sSource As String
  163.     If e > 1000 Then
  164.         sSource = App.ExeName & ".ExeType"
  165.         Select Case e
  166.         Case eeBaseExeType
  167.             BugAssert True
  168.        ' Case ee...
  169.        '     Add additional errors
  170.         End Select
  171.         Err.Raise COMError(e), sSource, sText
  172.     Else
  173.         ' Raise standard Visual Basic error
  174.         sSource = App.ExeName & ".VBError"
  175.         Err.Raise e, sSource
  176.     End If
  177. End Sub
  178. #End If
  179.  
  180.